home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Source Code / Libraries / SAT 2.3.8 / Libraries & Documentation / Add-ons / Graphic effects / MySlotVBL.p < prev    next >
Text File  |  1996-05-11  |  4KB  |  178 lines

  1. {A VBL synching unit for SAT or general use alike.}
  2.  
  3. {Based on SlotVInstall.p from DTS, but significantly enhanced; works without Color QD}
  4. {and is a reusable unit.}
  5. {}
  6. {By Ingemar Ragnemalm 1996.}
  7. {}
  8. {Noteable features:}
  9. {Works with both 68k and PPC, and both Think and CodeWarrior.}
  10. {Uses SLotVBL if available, but falls back to old-style VBL on old Macs.}
  11.  
  12. {Both the unit and the routines might be renamed in future versions.}
  13.  
  14. unit MySlotVBL;
  15.  
  16. interface
  17.     uses
  18. {$IFC UNDEFINED THINK_PASCAL}
  19.         Types, Devices, QuickDraw, OSUtils, 
  20. {$ELSEC}
  21. {$SETC GENERATINGPOWERPC := FALSE}
  22. {$ENDC}
  23.         Retrace;
  24.  
  25.     function InstallVBL (myGDevHand: GDHandle): OSErr;
  26.     procedure RemoveVBL;
  27.  
  28.     function GetVBLValue: Longint;
  29.     procedure SetVBLValue (value: Longint);
  30.  
  31. {To synch SAT by VBL, install SATSynch as synch procedure.}
  32. {CAUTION: InstallVBL must have succeeded, or SATSynch will wait forever!}
  33. {Also, don't forget a RemoveVBL when you quit!}
  34.     function SATSynch: Boolean;
  35.  
  36. implementation
  37.  
  38.     const
  39.         kVBLCount = 1;
  40.  
  41.     type
  42.         EnhVBLTask = record
  43.                 theVBLTask: VBLTask;
  44.                 theGlobal: ^LongInt;
  45.             end;
  46.         EnhVBLTaskPtr = ^EnhVBLTask;
  47.  
  48.     var
  49.         myVBLTask: EnhVBLTask;
  50.         gLong: Longint;
  51.         installed, installedColor: Boolean;
  52.  
  53.     function GetVBLValue: Longint;
  54.     begin
  55.         GetVBLValue := gLong; {myVBLTask.theGlobal;}
  56.     end; {GetVBLValue}
  57.  
  58.     procedure SetVBLValue (value: Longint);
  59.     begin
  60. {myVBLTask.theGlobal := }
  61.         gLong := value;
  62.     end; {SetVBLValue}
  63.  
  64. {$PUSH}
  65. {$D-}
  66.  
  67. {$IFC GENERATINGPOWERPC}
  68.  
  69.     procedure MyVBLProc (theEnhVBLTaskRecPtr: EnhVBLTaskPtr);
  70.     begin
  71.         theEnhVBLTaskRecPtr^.theGlobal^ := theEnhVBLTaskRecPtr^.theGlobal^ + 1;
  72.         { reset VBL }
  73.         theEnhVBLTaskRecPtr^.theVBLTask.vblCount := kVBLCount;
  74.     end; {MyVBLProc, PPC}
  75.  
  76. {$ELSEC}
  77.     function GetVBLRec: EnhVBLTaskPtr;
  78.     inline
  79.         $2E88; { put A0 on stack }
  80.  
  81.     procedure MyVBLProc;
  82.         var
  83.             theEnhVBLTaskRecPtr: EnhVBLTaskPtr;
  84.     begin
  85.         theEnhVBLTaskRecPtr := GetVBLRec;
  86.  
  87.         theEnhVBLTaskRecPtr^.theGlobal^ := theEnhVBLTaskRecPtr^.theGlobal^ + 1;
  88.         { reset VBL }
  89.         theEnhVBLTaskRecPtr^.theVBLTask.vblCount := kVBLCount;
  90.     end; {MyVBLProc, 68k}
  91. {$ENDC}
  92.  
  93. {$POP}
  94.  
  95.     var
  96.         myDCEHand: AuxDCEHandle;        {Kept for SlotVRemove!}
  97.  
  98.     function HasColor: Boolean;
  99.         var
  100.             theWorld: SysEnvRec;
  101.     begin
  102.         HasColor := false;
  103.         if SysEnvirons(1, theWorld) = noErr then
  104.             HasColor := theWorld.hasColorQD;
  105.     end; {HasColor}
  106.  
  107.     function InstallVBL (myGDevHand: GDHandle): OSErr;
  108.         var
  109.             mainGDRefNum: INTEGER;
  110.             vblGlobalLongInt, tempLongInt: LONGINT;
  111.             retCode: OSErr;
  112.     begin
  113.         if installed then
  114.             begin
  115.                 InstallVBL := -1;        {Already installed}
  116.                 Exit(InstallVBL);
  117.             end;
  118.  
  119. {If no device is provided, use the main device as default!}
  120.         if myGDevHand = nil then
  121.             if HasColor then
  122.                 myGDevHand := GetMainDevice;
  123.  
  124.         if HasColor and (myGDevHand <> nil) then
  125.             begin
  126.                 mainGDRefNum := myGDevHand^^.gdRefNum;
  127.                 myDCEHand := AuxDCEHandle(GetDctlEntry(mainGDRefNum));
  128.                 installedColor := true;
  129.             end
  130.         else
  131.             installedColor := false;
  132.  
  133.     { set up VBL task }
  134.         myVBLTask.theVBLTask.qType := ORD(vType);
  135. {$IFC UNDEFINED THINK_PASCAL}
  136.         myVBLTask.theVBLTask.vblAddr := NewVBLProc(@MyVBLProc);
  137. {$ELSEC}
  138.         myVBLTask.theVBLTask.vblAddr := @MyVBLProc;
  139. {$ENDC}
  140.         myVBLTask.theVBLTask.vblCount := kVBLCount;
  141.         myVBLTask.theVBLTask.vblPhase := 0;
  142.         myVBLTask.theGlobal := @gLong;
  143.  
  144.         vblGlobalLongInt := 0;
  145.         tempLongInt := 0;
  146.  
  147.         if installedColor then
  148.             retCode := SlotVInstall(@myVBLTask, myDCEHand^^.dCtlSlot)
  149.         else
  150.             retCode := VInstall(@myVBLTask);
  151.         InstallVBL := retCode;
  152.  
  153.         installed := retCode = noErr;
  154.     end; {InstallVBL}
  155.  
  156.     procedure RemoveVBL;
  157.         var
  158.             retCode: OSErr;
  159.     begin
  160.         if installed then
  161.             if installedColor then
  162.                 retCode := SlotVRemove(@myVBLTask, myDCEHand^^.dCtlSlot)
  163.             else
  164.                 retCode := VRemove(@myVBLTask);
  165. {I don't return the error code. I mean, what can be done about it?}
  166.         installed := false;
  167.     end; { ELSE }
  168.  
  169. {A standard synch proc for SAT:}
  170.     function SATSynch: Boolean;
  171.     begin
  172.         gLong := 0;                {or SetVBLValue(0);}
  173.         while gLong = 0 do        {or GetVBLValue = 0}
  174.             ;
  175.         SATSynch := false;        {Always return false!}
  176.     end; {SATSynch}
  177.  
  178. end.